home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / prog_bas / mcsecure.zip / MCSECURE.BAS < prev    next >
BASIC Source File  |  1996-05-16  |  6KB  |  215 lines
  1. Attribute VB_Name = "SECURITY_bas"
  2. Option Explicit
  3.  
  4. Public Const ApplicationName = "MC-SECURITY"
  5.  
  6. Public DirectoryForApplication      As String
  7. Public SelectedLanguage             As String
  8. Public CurrentLanguage              As Integer
  9. Public SaveTitleForm                As String
  10.  
  11. Public FileToUse                    As String
  12.  
  13. Public SERIALDATA                   As tagSERIALDATA
  14.  
  15.  
  16. Sub FileProcessAdd()
  17.  
  18.    Dim ErrCode          As Integer
  19.    Dim WasSerial        As Integer
  20.  
  21.    ' get the full name to use
  22.    FileToUse = GetFileToUse()
  23.  
  24.    ' if no file selected, stop
  25.    If (Len(FileToUse) = 0) Then Exit Sub
  26.  
  27.    ' check if file is serialized
  28.    WasSerial = cIsSerial(FileToUse)
  29.  
  30.    ' format the serial number field
  31.    frmSerialization.SerNumber.Text = Val(frmSerialization.SerNumber.Text)
  32.  
  33.    ' set the serialization info from fields
  34.    SERIALDATA.Description1 = frmSerialization.SerPart1.Text
  35.    SERIALDATA.Description2 = frmSerialization.SerPart2.Text
  36.    SERIALDATA.Number = frmSerialization.SerNumber.Text
  37.    ' put the serialization info
  38.    ErrCode = cSerialPut(FileToUse, SERIALDATA)
  39.  
  40.    ' check if file was been serialized
  41.    If (WasSerial = False) Then
  42.       ' yes, display the message
  43.       Call MessageDisplay("2", FileToUse)
  44.  
  45.    Else
  46.       ' no, display the message
  47.       Call MessageDisplay("3", FileToUse)
  48.  
  49.    End If
  50.  
  51. End Sub
  52.  
  53. Sub FileProcessChange()
  54.  
  55.    Dim ErrCode          As Integer
  56.  
  57.    ' get the full name to use
  58.    FileToUse = GetFileToUse()
  59.  
  60.    ' if no file selected, stop
  61.    If (Len(FileToUse) = 0) Then Exit Sub
  62.  
  63.    ' check if file is serialized
  64.    If (cIsSerial(FileToUse) = 0) Then
  65.       ' no, display error
  66.       Call MessageDisplay("1", FileToUse)
  67.  
  68.    Else
  69.       ' yes, add 1 to serial number
  70.       ErrCode = cSerialInc(FileToUse, 1)
  71.       ' read the serialization info
  72.       ErrCode = cSerialGet(FileToUse, SERIALDATA)
  73.       ' set the serialization info on fields
  74.       frmSerialization.SerPart1.Text = SERIALDATA.Description1
  75.       frmSerialization.SerPart2.Text = SERIALDATA.Description2
  76.       frmSerialization.SerNumber.Text = SERIALDATA.Number
  77.       ' check the serial number, for example MOD 10
  78.       If ((SERIALDATA.Number Mod 10) = 0) Then
  79.          ' yes, modulo 10, display message
  80.          Call MessageDisplay("4", FileToUse)
  81.       End If
  82.  
  83.    End If
  84.  
  85. End Sub
  86.  
  87. Sub FileProcessRead()
  88.  
  89.    Dim ErrCode          As Integer
  90.  
  91.    ' get the full name to use
  92.    FileToUse = GetFileToUse()
  93.  
  94.    ' if no file selected, stop
  95.    If (Len(FileToUse) = 0) Then Exit Sub
  96.  
  97.    ' check if file is serialized
  98.    If (cIsSerial(FileToUse) = 0) Then
  99.       ' no, display error
  100.       Call MessageDisplay("1", FileToUse)
  101.  
  102.    Else
  103.       ' yes, display the serialization info
  104.       ErrCode = cSerialGet(FileToUse, SERIALDATA)
  105.       ' set the serialization info on fields
  106.       frmSerialization.SerPart1.Text = SERIALDATA.Description1
  107.       frmSerialization.SerPart2.Text = SERIALDATA.Description2
  108.       frmSerialization.SerNumber.Text = SERIALDATA.Number
  109.  
  110.    End If
  111.  
  112. End Sub
  113.  
  114. Sub FileProcessRemove()
  115.  
  116.    Dim ErrCode          As Integer
  117.  
  118.    ' get the full name to use
  119.    FileToUse = GetFileToUse()
  120.  
  121.    ' if no file selected, stop
  122.    If (Len(FileToUse) = 0) Then Exit Sub
  123.  
  124.    ' check if file is serialized
  125.    If (cIsSerial(FileToUse) = 0) Then
  126.       ' no, display error
  127.       Call MessageDisplay("1", FileToUse)
  128.  
  129.    Else
  130.       ' yes, remove the serialization info
  131.       ErrCode = cSerialRmv(FileToUse)
  132.       ' display remove message
  133.       Call MessageDisplay("5", FileToUse)
  134.  
  135.    End If
  136.  
  137. End Sub
  138.  
  139. Function GetFileToUse() As String
  140.  
  141.    ' check if a file has been selected
  142.    If (frmSerialization.file1.ListIndex >= 0) Then
  143.       ' yes, form the full name
  144.       GetFileToUse = frmSerialization.file1.Path + "\" + frmSerialization.file1.List(frmSerialization.file1.ListIndex)
  145.  
  146.    Else
  147.  
  148.       Call MessageDisplay("0", "")
  149.       
  150.       ' no, return empty
  151.       GetFileToUse = ""
  152.  
  153.    End If
  154.  
  155. End Function
  156.  
  157. Sub Loader()
  158.  
  159.    DoEvents
  160.    
  161.    ' some initializations
  162.    DirectoryForApplication = App.Path + "\"
  163.  
  164.    ' save the caption of this form
  165.    SaveTitleForm = frmSerialization.Caption
  166.    
  167. End Sub
  168.  
  169. Sub MessageDisplay(TextOrder As String, InsertText As String)
  170.  
  171.    ' display a multi-language message box, message are centered
  172.    ' and a timeout of 30 seconds is displayed.
  173.    MsgBox ReadText(TextOrder, InsertText), vbOKOnly, SaveTitleForm
  174.    
  175.    frmSerialization.ZOrder 0
  176.  
  177. End Sub
  178.  
  179. Function ReadText(TextOrder As String, InsertText As String) As String
  180.  
  181.    Dim i                As Integer
  182.    Dim n                As Integer
  183.    Dim Tmp              As String
  184.    Dim BasisText        As String
  185.    
  186.    Select Case TextOrder
  187.       Case "0": BasisText = "You must select a file !"
  188.       Case "1": BasisText = "File '~' is not a serialized file !"
  189.       Case "2": BasisText = "File '~' is now serialized."
  190.       Case "3": BasisText = "File '~' was serialized.ººSerialization has been updated."
  191.       Case "4": BasisText = "Message sample.ººYou've tried this program more than 10 uses.ººRegister this program.ººMessage sample."
  192.       Case "5": BasisText = "Serialization information on file '~' has been removed."
  193.    End Select
  194.  
  195.    ' insert some text if any
  196.    n = InStr(BasisText, "~")
  197.    If (n > 0) Then
  198.       Tmp = Left$(BasisText, n - 1) + InsertText + Mid$(BasisText, n + 1)
  199.    Else
  200.       Tmp = BasisText
  201.    End If
  202.  
  203.    ' change all º to make a CR
  204.    n = 0
  205.    n = InStr(n + 1, Tmp, "º")
  206.    Do While (n > 0)
  207.       Mid$(Tmp, n, 1) = vbCr
  208.       n = InStr(n + 1, Tmp, "º")
  209.    Loop
  210.  
  211.    ReadText = Tmp
  212.  
  213. End Function
  214.  
  215.